home *** CD-ROM | disk | FTP | other *** search
/ PC World 2006 September / PCWorld_2006-09_cd.bin / v cisle / samurize / samurize_1.64.exe / Packages / new dego 5.01.sam / scripts / ExternalIP.vbs < prev   
Text File  |  2004-03-22  |  3KB  |  122 lines
  1. '--------------------------------------------------------------------------------
  2. '  ExternalIP.vbs (v1.4)
  3. '--------------------------------------------------------------------------------
  4. '
  5. ' Retreives your external IP address from http://checkip.dyndns.org/ (this is 
  6. ' useful for computers behind routers and firewalls)
  7. '
  8. ' Changes in v1.4
  9. '
  10. ' - internet connection detected (thanks AdamC)
  11. '
  12. '
  13. ' Changes in v1.3
  14. '
  15. ' - international version returns 2 IP addresses if you have multiple NICs in your
  16. '   computer - fixed to only show one. (Thanks Rasman)
  17. '
  18. ' Changes in v1.2
  19. '
  20. ' - uses new URL to save bandwidth
  21. ' - Old script was actually returning proxy IP, not actual IP!
  22. '
  23. ' Changes in v1.1:
  24. '
  25. ' - Added error messages
  26. ' - Hid relevant functions from Samurize 0.85b
  27. '
  28. '                                -NeM
  29. '--------------------------------------------------------------------------------
  30.  
  31. Const CheckConnected      = True                            ' Whether you want the script to check if its connected to the internet
  32.                                                             ' Either True of False
  33.  
  34.  
  35. Function getExternalIP ()
  36.  
  37.  
  38.     dim htmlResult
  39.     
  40.     'Check that Computer is connected to the internet
  41.     Connected = IsConnectible("checkip.dyndns.org","","")    
  42.  
  43.     if Connected = True OR CheckConnected = False then
  44.         htmlResult = ReturnHTML("http://checkip.dyndns.org/")
  45.  
  46.         leftMark = instr(htmlResult, "Address: " ) + 9
  47.  
  48.         if Instr(htmlResult, ",") > 0 Then
  49.             rightMark = instr( htmlResult, ",") - 1
  50.         else
  51.             rightMark = instr( htmlResult, "</body>") - 1
  52.         End If
  53.  
  54.         if rightMark > 0 Then
  55.  
  56.             'grabs the IP
  57.             getExternalIP = mid( htmlResult, leftMark, rightMark - leftMark + 1)
  58.  
  59.         else
  60.             getExternalIP = "ERROR"
  61.  
  62.         end if
  63.     Else
  64.         getExternalIP = "Offline"
  65.     End If
  66.  
  67. End Function
  68.  
  69. Private Function ReturnHTML(sURL)
  70.     Dim objXMLHTTP,HTML
  71.     Set objXMLHTTP = CreateObject("Microsoft.XMLHTTP")
  72.     objXMLHTTP.Open "GET", sURL, False
  73.     objXMLHTTP.Send
  74.     HTML = objXMLHTTP.responseBody
  75.     Set objRS = CreateObject("ADODB.Recordset")
  76.     objRS.Fields.Append "txt", 200, 45000, &H00000080
  77.     objRS.Open
  78.     objRS.AddNew
  79.     objRS.Fields("txt").AppendChunk HTML
  80.     ReturnHTML = objRS("txt").Value
  81.     objRS.Close
  82.     Set objRS = Nothing
  83.     Set objXMLHTTP = Nothing
  84.  
  85. End Function
  86.  
  87. ' This was done by someone on the forums which I copied, and can I find that post again can I heck
  88. ' So who every you are thanks for the cold.
  89. Private Function IsConnectible(sHost,iPings,iTO)
  90.     ' Works an "all" WSH versions
  91.     ' sHost is a hostname or IP
  92.  
  93.     ' iPings is number of ping attempts
  94.     ' iTO is timeout in milliseconds
  95.     ' if values are set to "", then defaults below used
  96.  
  97.      If iPings = "" Then iPings = 2
  98.      If iTO = "" Then iTO = 750
  99.     
  100.      Const OpenAsDefault    = -2
  101.      Const FailIfNotExist   =  0
  102.      Const ForReading       =  1
  103.     
  104.      Set oShell = CreateObject("WScript.Shell")
  105.      Set oFSO = CreateObject("Scripting.FileSystemObject")
  106.      sTemp = oShell.ExpandEnvironmentStrings("%TEMP%")
  107.      sTempFile = sTemp & "\runresult.tmp"
  108.  
  109.      oShell.Run "%comspec% /c ping -n " & iPings & " -w " & iTO & " " & sHost & ">" & sTempFile, 0 , True
  110.     
  111.      Set fFile = oFSO.OpenTextFile(sTempFile, ForReading, FailIfNotExist, OpenAsDefault)
  112.  
  113.      sResults = fFile.ReadAll
  114.      fFile.Close
  115.      oFSO.DeleteFile(sTempFile)
  116.     
  117.      Select Case InStr(sResults,"TTL=")
  118.        Case 0 IsConnectible = False
  119.        Case Else IsConnectible = True
  120.      End Select
  121. End Function
  122.